home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
recurs1a
/
domtree.frm
< prev
next >
Wrap
Text File
|
1999-08-27
|
18KB
|
536 lines
VERSION 5.00
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "SHDOCVW.DLL"
Begin VB.Form frmDOMTree
BackColor = &H00FFFFFF&
Caption = "DOM Tree"
ClientHeight = 4395
ClientLeft = 60
ClientTop = 630
ClientWidth = 5880
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 4395
ScaleWidth = 5880
WindowState = 2 'Maximized
Begin SHDocVwCtl.WebBrowser wbr
Height = 2235
Left = 720
TabIndex = 0
Top = 840
Width = 4515
ExtentX = 7964
ExtentY = 3942
ViewMode = 0
Offline = 0
Silent = 0
RegisterAsBrowser= 0
RegisterAsDropTarget= 1
AutoArrange = 0 'False
NoClientEdge = 0 'False
AlignLeft = 0 'False
ViewID = "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
Location = ""
End
Begin VB.Menu mnuFileMenu
Caption = "&File"
Index = 0
Begin VB.Menu mnuFile
Caption = "&HTML"
Index = 0
End
Begin VB.Menu mnuFile
Caption = "-"
Index = 1
End
Begin VB.Menu mnuFile
Caption = "&Close"
Index = 2
End
End
End
Attribute VB_Name = "frmDOMTree"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' DOMTree.frm July 1999 contact markb@orionstudios.com
' Demonstrates DOM programming from Vb6 including
' recursive traversal of an HTML document structure (see RecurseDOMTree)
' extracting stylesheet information from a document (see DisplayStyleSheets)
' constructing an expand/collapse UL object and inserting it into a document
' cloning a structure (see CreatePropsClone, CreateInfoSpan)
' intercepting click events from WebBrowser document (see mProps, mExpand)
' behavior (DOMTree.htc) attached to DIV (MainDIV) via CSS class (DOMTree.css)
'
' Requires Project/References entry for
' Microsoft HTML Object Library (MSHTML.tlb)
'====================================================================================
' Enumerations
Public Enum DOMInfoType ' determines which display is built - see DisplayDOMInfo
domiTree ' Document Tree
domiStyle ' Style Specs
End Enum
' Module-level Object variables
Private mvarMDIParent As MDIForm ' useful to access parent form - see StatusText
Private mDOMDoc As MSHTML.HTMLDocument ' document to be analysed - see DisplayDOMInfo
Private mWbrDoc As MSHTML.HTMLDocument ' document in WebBrowser (HTML_TEMPLATE)
Private mWbrDocWin As MSHTML.HTMLWindow2 ' window containing WebBrowser document
Attribute mWbrDocWin.VB_VarHelpID = -1
Private mULRoot As MSHTML.HTMLUListElement ' top-level UL added to WebBrowser document
Private mCloneSPAN As MSHTML.HTMLSpanElement ' see CreatePropsClone
' Objects in WebBrowser document HTML_TEMPLATE
Private mProgressNodes As MSHTML.IHTMLDOMTextNode ' progress display
Private WithEvents mProps As MSHTML.HTMLTableCell ' toggles properties display
Attribute mProps.VB_VarHelpID = -1
Private WithEvents mExpand As MSHTML.HTMLTableCell ' expands/collapses tree display
Attribute mExpand.VB_VarHelpID = -1
' Miscellaneous module-level variables
Private mDefaultPath As String ' assigned in Form_Initialize
Private mDOMInfoType As DOMInfoType ' indicates which display is built
Private mDOMInfoCaption As Variant ' array of caption strings
Private mNodeCount As Long ' compared with PROGRESS_INTERVAL
' Module-level Constants
Private Const PROGRESS_INTERVAL As Long = 20 ' see AddLInode_Exit
Private Const HTML_TEMPLATE = "DOMTree.htm" ' template for building display
Private Const CL_INFOSPAN = "infoSPAN"
Private Const CL_PARENT = "clParent"
Private Const CL_CHILD = "clChild"
Private Const WORKING = " Working ..."
Private Const READY = " Ready"
' Relevant nodeType constants
Private Const ELEMENT_NODE = 1
Private Const TEXT_NODE = 3
' Browser navigation constants
Private Const navNoHistory = 2
' File Menu Constants
Private Const FILE_HTML = 0
Private Const FILE_CLOSE = 2
Public Property Set MDIParent(vData As MDIForm) ' optional
Set mvarMDIParent = vData
End Property
Private Property Let StatusText(ByVal vData As String)
On Error Resume Next
If Not (mvarMDIParent Is Nothing) Then ' property spec is optional
mvarMDIParent.StatusText = vData
End If
End Property
Public Sub DisplayDOMInfo( _
HTMLDoc As MSHTML.HTMLDocument, _
InfoType As DOMInfoType)
Set mDOMDoc = HTMLDoc ' retain as module-level variable
mDOMInfoType = InfoType ' retain as module-level variable
Me.Caption = mDOMInfoCaption(mDOMInfoType)
' Processing is triggered when HTML_TEMPLATE is loaded (see wbr_DocumentComplete)
wbr.Navigate URL:=mDefaultPath & HTML_TEMPLATE, Flags:=navNoHistory
End Sub
Private Sub Form_Initialize()
mDefaultPath = App.Path & "\"
mDOMInfoCaption = Array("Document Tree", "Style Specs")
mDOMInfoType = domiTree ' default DOMDocInfo property
End Sub
Private Sub Form_Load()
StatusText = WORKING
wbr.Navigate "about:<BODY style='overflow:auto'></BODY>", Flags:=navNoHistory
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Me.Visible = False ' An attempt to speed up closing the form because
DoEvents ' displosing of the document may take a while.
End Sub
Private Sub Form_Resize()
On Error Resume Next
wbr.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
End Sub
Private Sub mnuFile_Click(Index As Integer)
On Error Resume Next
Select Case Index
Case FILE_HTML
With New frmDOMHTML
.Show
.DisplayHTML HTMLDoc:=wbr.Document
End With
Case FILE_CLOSE
Unload Me
End Select
End Sub
Private Sub wbr_DocumentComplete(ByVal pDisp As Object, URL As Variant)
If pDisp Is wbr.object Then
If InStr(1, URL, HTML_TEMPLATE, vbTextCompare) Then
Set mWbrDoc = wbr.Document ' typecast for early binding
With mWbrDoc
Set mWbrDocWin = .parentWindow
Set mProgressNodes = .getElementById("idRow").firstChild
.getElementById("idHdr").firstChild.nodeValue = mDOMInfoCaption(mDOMInfoType)
End With
DoEvents
Select Case mDOMInfoType
Case domiTree
RecurseDOMTree StartFromNode:=mDOMDoc.getElementsByTagName("HTML")(0)
Case domiStyle
DisplayStyleSheets HTMLDoc:=mDOMDoc
End Select
StatusText = READY
End If
End If
End Sub
Private Function mProps_onclick() As Boolean ' Event generated in HTML_TEMPLATE
Dim blnShow As Boolean
StatusText = WORKING
mWbrDocWin.Event.cancelBubble = True
blnShow = InStr(1, mProps.firstChild.nodeValue, "Show", vbTextCompare)
PropsToggle ShowAll:=blnShow
mProps.firstChild.nodeValue = IIf(blnShow, "Hide", "Show") & " properties"
StatusText = READY
End Function
Private Function mExpand_onclick() As Boolean ' Event generated in HTML_TEMPLATE
Dim blnExpand As Boolean
StatusText = WORKING
mWbrDocWin.Event.cancelBubble = True
blnExpand = InStr(1, mExpand.firstChild.nodeValue, "Expand", vbTextCompare)
ExpandToggle ExpandAll:=blnExpand
mExpand.firstChild.nodeValue = IIf(blnExpand, "Collapse", "Expand") & " all"
StatusText = READY
End Function
Private Sub RecurseDOMTree(StartFromNode As MSHTML.IHTMLDOM